home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / demos / imagegadget.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-01-01  |  9.6 KB  |  405 lines
  1. PROGRAM ImageGadget;
  2.  
  3. {
  4.    An example on how to use GadTools gadgets,
  5.    on the same time how to use images.
  6.    20 Sep 1998.
  7.  
  8.    Changed the code to use TAGS, now also use
  9.    pas2c for strings-pchar.
  10.    1 Nov 1998.
  11.  
  12.    Removed opening of gadtools.library.
  13.    Will be opened by unit gadtools.
  14.    16 Jul 2000.
  15.  
  16.    nils.sjoholm@mailbox.swipnet.se
  17. }
  18.  
  19. USES Intuition, Exec, Graphics, GadTools, Utility, vartags,pastoc;
  20.  
  21.  
  22. CONST
  23.   MSG_NO_PS            : PChar = 'Can''t lock Public Screen';
  24.   MSG_NO_VI            : PChar = 'Can''t get Visual Info';
  25.   MSG_NO_MEM           : PChar = 'Not enough memory free';
  26.   MSG_NO_WP            : PChar = 'Can''t open window';
  27.  
  28.   WIN_TITLE            : PChar = 'Images-Example';
  29.   OK_TEXT              : PChar = 'OK';
  30.  
  31.   type
  32.       data = array[1..176] of word;
  33.       pdata = ^data;
  34.  
  35.   const
  36.     renderd : data = (
  37.     {* Plane 0 *}
  38.         $0000,$0000,
  39.         $0000,$0010,
  40.         $0000,$0010,
  41.         $0000,$0010,
  42.         $01C0,$0010,
  43.         $03E0,$0010,
  44.         $07F0,$0010,
  45.         $0000,$0010,
  46.         $0000,$0810,
  47.         $039A,$C810,
  48.         $0000,$0810,
  49.         $031E,$0810,
  50.         $0000,$4810,
  51.         $03E6,$0810,
  52.         $0000,$0810,
  53.         $0000,$0810,
  54.         $07FF,$F810,
  55.         $0000,$0010,
  56.         $0000,$0010,
  57.         $0000,$0010,
  58.         $0000,$0010,
  59.         $7FFF,$FFF0,
  60.     {* Plane 1 *}
  61.         $FFFF,$FFE0,
  62.         $8000,$0000,
  63.         $8000,$0000,
  64.         $8000,$0000,
  65.         $81C0,$0000,
  66.         $83E0,$0000,
  67.         $87F0,$0000,
  68.         $8000,$0000,
  69.         $87FF,$E000,
  70.         $8465,$2000,
  71.         $87FF,$E000,
  72.         $84E1,$E000,
  73.         $87FF,$A000,
  74.         $8419,$E000,
  75.         $87FF,$E000,
  76.         $8400,$0000,
  77.         $8000,$0000,
  78.         $8000,$0000,
  79.         $8000,$0000,
  80.         $8000,$0000,
  81.         $8000,$0000,
  82.         $0000,$0000,
  83.     {* Plane 2 *}
  84.         $0000,$0000,
  85.         $0000,$0020,
  86.         $0000,$0020,
  87.         $0000,$0020,
  88.         $0000,$0020,
  89.         $01C0,$0020,
  90.         $03E0,$0020,
  91.         $0FFF,$F820,
  92.         $0800,$1020,
  93.         $0800,$1020,
  94.         $0800,$1020,
  95.         $0800,$1020,
  96.         $0800,$1020,
  97.         $0800,$1020,
  98.         $0800,$1020,
  99.         $0BFF,$F020,
  100.         $0800,$0020,
  101.         $0000,$0020,
  102.         $0000,$0020,
  103.         $0000,$0020,
  104.         $7FFF,$FFE0,
  105.         $0000,$0000,
  106.  
  107.         $0000,$0000,
  108.         $0000,$0000,
  109.         $0000,$0000,
  110.         $0000,$0000,
  111.         $0000,$0000,
  112.         $0000,$0000,
  113.         $0000,$0000,
  114.         $0000,$0000,
  115.         $0000,$0000,
  116.         $0000,$0000,
  117.         $0000,$0000,
  118.         $0000,$0000,
  119.         $0000,$0000,
  120.         $0000,$0000,
  121.         $0000,$0000,
  122.         $0000,$0000,
  123.         $0000,$0000,
  124.         $0000,$0000,
  125.         $0000,$0000,
  126.         $0000,$0000,
  127.         $0000,$0000,
  128.         $0000,$0000
  129.     );
  130.  
  131.      selectd : data = (
  132.         { Plane 0 }
  133.                 $FFFF,$FFE0,
  134.                 $8000,$0000,
  135.                 $8000,$0000,
  136.                 $8000,$0000,
  137.                 $8000,$0000,
  138.                 $80E0,$0000,
  139.                 $81F0,$0000,
  140.                 $83F8,$0000,
  141.                 $8000,$0000,
  142.                 $8000,$0400,
  143.                 $81CD,$6400,
  144.                 $8000,$0400,
  145.                 $818F,$0400,
  146.                 $8000,$2400,
  147.                 $81F3,$0400,
  148.                 $8000,$0400,
  149.                 $8000,$0400,
  150.                 $83FF,$FC00,
  151.                 $8000,$0000,
  152.                 $8000,$0000,
  153.                 $8000,$0000,
  154.                 $0000,$0000,
  155.         { Plane 1 }
  156.                 $0000,$0000,
  157.                 $0000,$0010,
  158.                 $0000,$0010,
  159.                 $0000,$0010,
  160.                 $0000,$0010,
  161.                 $00E0,$0010,
  162.                 $01F0,$0010,
  163.                 $03F8,$0010,
  164.                 $0000,$0010,
  165.                 $03FF,$F010,
  166.                 $0232,$9010,
  167.                 $03FF,$F010,
  168.                 $0270,$F010,
  169.                 $03FF,$D010,
  170.                 $020C,$F010,
  171.                 $03FF,$F010,
  172.                 $0200,$0010,
  173.                 $0000,$0010,
  174.                 $0000,$0010,
  175.                 $0000,$0010,
  176.                 $0000,$0010,
  177.                 $7FFF,$FFF0,
  178.         { Plane 2 }
  179.                 $0000,$0000,
  180.                 $0000,$0020,
  181.                 $0000,$0020,
  182.                 $0000,$0020,
  183.                 $0000,$0020,
  184.                 $0000,$0020,
  185.                 $00E0,$0020,
  186.                 $01F0,$0020,
  187.                 $07FF,$FC20,
  188.                 $0400,$0820,
  189.                 $0400,$0820,
  190.                 $0400,$0820,
  191.                 $0400,$0820,
  192.                 $0400,$0820,
  193.                 $0400,$0820,
  194.                 $0400,$0820,
  195.                 $05FF,$F820,
  196.                 $0400,$0020,
  197.                 $0000,$0020,
  198.                 $0000,$0020,
  199.                 $7FFF,$FFE0,
  200.                 $0000,$0000,
  201.  
  202.         $0000,$0000,
  203.         $0000,$0000,
  204.         $0000,$0000,
  205.         $0000,$0000,
  206.         $0000,$0000,
  207.         $0000,$0000,
  208.         $0000,$0000,
  209.         $0000,$0000,
  210.         $0000,$0000,
  211.         $0000,$0000,
  212.         $0000,$0000,
  213.         $0000,$0000,
  214.         $0000,$0000,
  215.         $0000,$0000,
  216.         $0000,$0000,
  217.         $0000,$0000,
  218.         $0000,$0000,
  219.         $0000,$0000,
  220.         $0000,$0000,
  221.         $0000,$0000,
  222.         $0000,$0000,
  223.         $0000,$0000
  224.                      );
  225.  
  226.  
  227. VAR
  228.   ps                : pScreen;
  229.   vi                : Pointer;
  230.   ng                : tNewGadget;
  231.   xoff, yoff,i      : Longint;
  232.   gl,g              : pGadget;
  233.   firstimage        : pdata;
  234.   secondimage       : pdata;
  235.   renderi,
  236.   selecti           : tImage;
  237.   wp                : pWindow;
  238.  
  239.  
  240. function NewGadget(left,top,width,height : Integer; txt : PChar; txtattr: pTextAttr;
  241.                    id : word; flags: Longint; visinfo, userdata : Pointer): 
  242. tNewGadget;
  243. var
  244.     ng : tNewGadget;
  245. begin
  246.     with ng do begin
  247.         ng_LeftEdge   := left;
  248.         ng_TopEdge    := top;
  249.         ng_Width      := width;
  250.         ng_Height     := height;
  251.         ng_GadgetText := txt;
  252.         ng_TextAttr   := txtattr;
  253.         ng_GadgetID   := id;
  254.         ng_Flags      := flags;
  255.         ng_VisualInfo := visinfo;
  256.         ng_UserData   := userdata;
  257.     END;
  258.     NewGadget := ng;
  259. end;
  260.  
  261. function Image(left,top,width,height,depth: Integer; imdata : pointer;
  262.                ppick, ponoff: byte; nextim : pImage): tImage;
  263. var
  264.     im : tImage;
  265. begin
  266.  
  267.         im.LeftEdge    := left;
  268.         im.TopEdge     := top;
  269.         im.Width       := width;
  270.         im.Height      := height;
  271.         im.Depth       := depth;
  272.         im.ImageData   := imdata;
  273.  
  274.         im.PlanePick   := ppick;
  275.         im.PlaneOnOff  := ponoff;
  276.  
  277.         im.NextImage   := nextim;
  278.  
  279.     Image := im;
  280. end;
  281.  
  282.  
  283.  
  284. FUNCTION EasyReq(wp : pWindow; title,body,gad : PChar) : Longint;
  285. VAR
  286.   es : tEasyStruct;
  287. BEGIN
  288.   es.es_StructSize:=SizeOf(tEasyStruct);
  289.   es.es_Flags:=0;
  290.   es.es_Title:=title;
  291.   es.es_TextFormat:=body;
  292.   es.es_GadgetFormat:=gad;
  293.  
  294.   EasyReq := EasyRequestArgs(wp,@es,0,NIL);
  295. END;
  296.  
  297. PROCEDURE CleanUp(why : PChar; rc : BYTE);
  298. BEGIN
  299.   IF assigned(wp) THEN CloseWindow(wp);
  300.   IF assigned(gl) THEN FreeGadgets(gl);
  301.   IF assigned(vi) THEN FreeVisualInfo(vi);
  302.   IF assigned(firstimage) THEN FreeVec(firstimage);
  303.   IF assigned(secondimage) THEN FreeVec(secondimage);
  304.    IF why <> nil THEN i := EasyReq(NIL,WIN_TITLE,why,OK_TEXT);
  305.   HALT(rc);
  306. END;
  307.  
  308. { Clones some datas from default pubscreen for fontsensitive
  309.   placing of gadgets. }
  310. PROCEDURE CloneDatas;
  311. BEGIN
  312.   ps := LockPubScreen(NIL);
  313.   IF ps = NIL THEN CleanUp(MSG_NO_PS,20)
  314.   ELSE
  315.   BEGIN
  316.      xoff := ps^.WBorLeft;
  317.      yoff := ps^.WBorTop + ps^.Font^.ta_YSize + 1;
  318.      vi := GetVisualInfoA(ps,NIL);
  319.      UnLockPubScreen(NIL, ps);
  320.      IF vi = NIL THEN CleanUp(MSG_NO_VI, 20);
  321.   END;
  322. END;
  323.  
  324. procedure AllocateImages;
  325. begin
  326.   firstimage := Pointer(AllocVec(SizeOf(data),MEMF_CLEAR OR MEMF_CHIP));
  327.   if firstimage = nil then CleanUp(MSG_NO_MEM,20);
  328.  
  329.   firstimage^ := renderd;
  330.  
  331.   renderi := Image(0,0,28,22,3,firstimage,$ff,$0,nil);
  332.  
  333.   secondimage := Pointer(AllocVec(SizeOf(data),MEMF_CLEAR OR MEMF_CHIP));
  334.   if secondimage = nil then CleanUp(MSG_NO_MEM,20);
  335.  
  336.   secondimage^ := selectd;
  337.  
  338.   selecti := Image(0,0,28,22,3,secondimage,$ff,$0,nil);
  339.  
  340. END;
  341.  
  342. PROCEDURE GenerateWindow;
  343. BEGIN
  344.   gl := NIL; gl := CreateContext(addr(gl));
  345.   IF gl = NIL THEN CleanUp(MSG_NO_MEM, 20);
  346.   ng := NewGadget(xoff+1,yoff+1,28,22,nil,nil,1,0,vi,nil);
  347.  
  348.   g := CreateGadgetA(GENERIC_KIND,gl,@ng,NIL);
  349.   IF g = NIL THEN CleanUp(MSG_NO_MEM, 20);
  350.  
  351.   g^.GadgetType := GTYP_BOOLGADGET;
  352.   g^.Flags := GFLG_GADGIMAGE OR GFLG_GADGHIMAGE; { 2 Images }
  353.   g^.Activation := GACT_RELVERIFY; { Verhalten wie ein BUTTON_KIND-Gadget }
  354.   g^.GadgetRender := @renderi;
  355.   g^.SelectRender := @selecti;
  356.  
  357.   wp := OpenWindowTagList(NIL,TAGS(
  358.                 WA_Gadgets, LONG(gl),
  359.                 WA_Title, longstr('Images in Gadgets'),
  360.                 WA_Flags, WFLG_SMART_REFRESH OR WFLG_NOCAREREFRESH OR
  361.                                 WFLG_DEPTHGADGET OR WFLG_DRAGBAR OR WFLG_CLOSEGADGET OR
  362.                                 WFLG_ACTIVATE,
  363.                 WA_Idcmp, IDCMP_GADGETUP OR IDCMP_CLOSEWINDOW,
  364.                 WA_InnerWidth, 100,
  365.                 WA_InnerHeight, 50,
  366.                 TAG_DONE));
  367.   
  368.   IF wp = NIL THEN CleanUp(MSG_NO_WP, 20);
  369. END;
  370.  
  371. PROCEDURE MainWait;
  372. VAR
  373.   msg : pIntuiMessage;
  374.   iclass : LONG;
  375.   ende : BOOLEAN;
  376. BEGIN
  377.   ende := FALSE;
  378.   REPEAT
  379.     msg := pIntuiMessage(WaitPort(wp^.UserPort));
  380.      msg := GT_GetIMsg(wp^.UserPort);
  381.      WHILE msg <> NIL DO
  382.      BEGIN
  383.         iclass := msg^.IClass;
  384.         GT_ReplyIMsg(msg);
  385.         CASE iclass OF
  386.           IDCMP_CLOSEWINDOW : ende := TRUE;
  387.           IDCMP_GADGETUP :
  388.              i := EasyReq(wp,WIN_TITLE,pas2c('You have clicked on the Gadget!'),pas2c('Wheeew!'));
  389.         ELSE END;
  390.        msg := GT_GetIMsg(wp^.UserPort);
  391.      END;
  392.   UNTIL ende;
  393. END;
  394.  
  395. BEGIN
  396.   new(gl);
  397.   CloneDatas;
  398.   AllocateImages;
  399.   GenerateWindow;
  400.   MainWait;
  401.   CleanUp(nil,0);
  402. END.
  403.  
  404.  
  405.